﻿Imports System.IO

Public Class Message

    Public Type As Integer
    Public Map() As Boolean
    Public Fields() As Field

    Public Sub New()
        ReDim Map(128)
        ReDim Fields(128)
    End Sub

    Public Sub SetField(FieldId As Integer, Type As FieldTypes, Length As Integer, Value As Object)
        Map(FieldId) = True
        Fields(FieldId) = New Field
        With Fields(FieldId)
            .Index = FieldId
            .Value = Value
            .Type = Type
            .Length = Length
        End With
    End Sub

    Public Function GetField(FieldId As Integer) As Object
        Return Fields(FieldId)
    End Function

    Public Sub ClearField(FieldId As Integer)
        Map(FieldId) = False
    End Sub

    Public Sub Write(Out As Stream)

        Dim Buffer As Byte()

        Dim BufferCrLf As Byte()
        ReDim BufferCrLf(1)
        BufferCrLf(0) = Asc(vbCr)
        BufferCrLf(1) = Asc(vbLf)

        'Пишем свой тип
        ReDim Buffer(1)
        Buffer(0) = Byte.Parse(Int(Type / 100).ToString, System.Globalization.NumberStyles.HexNumber)
        Buffer(1) = Byte.Parse(Int(Type Mod 100).ToString, System.Globalization.NumberStyles.HexNumber)

        Out.Write(Buffer, 0, Buffer.Length)

        'Определяем, сколько сегментов у нас будет


        'Пишем битовую маску полей
        ReDim Buffer(8)
        For i = 1 To Map.Length - 1
            If Map(i) Then
                Dim ActiveByte = Int(i / 8) + 1
                Dim ActiveBit = i Mod 8

                Select Case ActiveBit
                    Case 0
                        Buffer(ActiveByte) = Buffer(ActiveByte) + 128
                    Case 1
                        Buffer(ActiveByte) = Buffer(ActiveByte) + 64
                    Case 2
                        Buffer(ActiveByte) = Buffer(ActiveByte) + 32
                    Case 3
                        Buffer(ActiveByte) = Buffer(ActiveByte) + 16
                    Case 4
                        Buffer(ActiveByte) = Buffer(ActiveByte) + 8
                    Case 5
                        Buffer(ActiveByte) = Buffer(ActiveByte) + 4
                    Case 6
                        Buffer(ActiveByte) = Buffer(ActiveByte) + 2
                    Case 7
                        Buffer(ActiveByte) = Buffer(ActiveByte) + 1
                End Select

            End If
        Next

        Out.Write(Buffer, 1, Buffer.Length - 1)

        'Out.Write(BufferCrLf, 0, BufferCrLf.Length)

        'Пишем сами поля
        For i = 1 To Map.Length - 1
            If Map(i) Then
                If Fields(i) IsNot Nothing Then
                    ReDim Buffer(Fields(i).Length - 1)
                    Dim A = Fields(i).Value.ToString

                    For j = 0 To Buffer.Length
                        Try
                            Buffer(j) = Asc(A.Substring(j, 1))
                        Catch ex As Exception
                        End Try
                    Next

                    Out.Write(Buffer, 0, Buffer.Length)
                    'Out.Write(BufferCrLf, 0, BufferCrLf.Length)
                End If
            End If
        Next

    End Sub

    Public Sub Read(Cin As Stream)

        Dim Buffer() As Byte

        'Читаем тип сообщения
        ReDim Buffer(1)
        Cin.Read(Buffer, 0, 2)

        Dim A1 = Hex(Buffer(0))
        Dim A2 = Hex(Buffer(1))
        If A1.Length = 1 Then A1 = "0" & A1
        If A2.Length = 1 Then A2 = "0" & A2

        Dim A3 = A1 & A2 ' 16ричное число
        Type = Integer.Parse(A3)

        'Читаем битовую маску. до 3х
        If ReadBitMap(Cin, 0) Then
            If ReadBitMap(Cin, 64) Then
                ReadBitMap(Cin, 128)
            End If
        End If

        ' Читаем поля
        For i = 1 To Map.Length - 1
            If Map(i) = True Then
                If Fields(i) IsNot Nothing Then
                    ReDim Buffer(Fields(i).Length - 1)
                    Cin.Read(Buffer, 0, Fields(i).Length)
                    Fields(i).Value = ByteArrayToString(Buffer)
                End If
            End If
        Next

    End Sub

    Public Function ConvertToBin(ByVal bByte As Long) As String
        Dim A As String
        Dim i As Integer
        For i = 0 To 7
            If bByte And 2 ^ i Then
                A = 1 & A
            Else
                A = 0 & A
            End If
        Next i
        Return A
    End Function

    Private Function ReadBitMap(Cin As Stream, MapOffset As Integer) As Boolean
        Dim Buffer() As Byte
        'Читаем битовую маску
        ReDim Buffer(7)
        Cin.Read(Buffer, 0, 8)

        'Переводим 8 бит в строку
        Dim B = ""
        For i = 0 To Buffer.Length - 1
            B = B & ConvertToBin(Buffer(i))
        Next

        For i = 1 To B.Length - 1
            If B.Substring(i, 1) = "1" Then
                Map(i + MapOffset) = True
            End If
        Next

        Return (B.Substring(0, 1) = "1")
    End Function

    Private Function ByteArrayToString(Ar As Byte())
        Dim A As String = ""
        For Each B In Ar
            A = A & Chr(B)
        Next
        Return A
    End Function

End Class

Public Class Field

    Public Index As Integer
    Public Type As FieldTypes
    Public Value As Object
    Public Desc As String = ""

    Public Len As Integer = 0
    Public LenVar As Boolean = False
    Public LenMax As Integer = 0
    Public LenId As Integer = 0

    Public Sub New()

    End Sub

    Public Sub New(Type As FieldTypes, Length As Integer)
        Me.Type = Type
        Me.Len = Length
    End Sub

    Public Sub New(Index As Integer, Type As FieldTypes, Len As Integer, LenVar As Boolean, LenMax As Integer, LenId As Integer, Desc As String)
        Me.Index = Index
        Me.Type = Type
        Me.Len = Len
        Me.LenVar = LenVar
        Me.LenMax = LenMax
        Me.LenId = LenId
    End Sub

    Public Sub GetValueFromStream(CIn As Stream)
        'If Type = 
    End Sub

End Class

Public Enum FieldTypes
    TYPE_A   'Alpha, including blanks
    TYPE_N   'Numeric values only
    TYPE_S   'Special characters only
    TYPE_AN  'Alphanumeric
    TYPE_AS 'Alpha & special characters only
    TYPE_NS 'Numeric and special characters only
    TYPE_ANS    'Alphabetic, numeric and special characters.
    TYPE_B  'Binary data
    TYPE_Z  'Tracks 2 and 3 code set as defined in ISO 4909 and ISO 7813
End Enum